home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1999 March / EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso / earcd / -archivi / -recent2 / amicad_2.00.lha / AmiCAD / ARexx / TestNets.AmiCAD < prev    next >
Text File  |  1999-02-27  |  8KB  |  296 lines
  1. /* Test des erreurs sur un schéma, dans le but de créer une netlist.
  2.    Version 1.00: 14 Juillet 1998
  3.    Version 1.01: 6 février 1999 (ajout UNLOCK après erreur
  4.    Version 1.02: 27 février 1999 (ajout fonction INIT pour variables)
  5.    $VER: 1.02 (© R.Florac, 27/2/99) */
  6.  
  7. options results     /* indispensable pour récupérer le résultat des macros */
  8.  
  9. signal on error     /* pour l'interception des erreurs */
  10. signal on syntax
  11.  
  12. c=1
  13. 'INIT(B,D,L,O,N):SAVEALL(-1):UNMARK(-1):OBJECTS(-1)'; objets=result
  14. 'DEF UNMARKCOMP(O)=IF(GETREF(O),UNMARK(GETREF(O)),0):IF(GETVAL(O),UNMARK(GETVAL(O)),0):UNMARK(O)'
  15.  
  16. modifs=0; eliminations=0; errrefs=0; errvals=0; errconx=0; doublets=0
  17. c="Test du schéma"||'0a'x||"1- Vérifier les références "||'0a'x||"2- Vérifier les valeurs    "||'0a'x||"3- Vérifier les connexions "||'0a'x||"4- Vérifier les liaisons   "||'0a'x||"5- Tester présence doublons"||'0a'x
  18. c=c||"6- Enchaîner tous les tests"||'0a'x||"7- Abandonner              "
  19. 'SELECT("'c'")'
  20. c=result
  21. select
  22.     when c=1 then call test_refs
  23.     when c=2 then call test_valeurs
  24.     when c=3 then call test_connexions
  25.     when c=4 then call test_liaisons
  26.     when c=5 then call test_doublets
  27.     when c=6 then do
  28.     call test_doublets
  29.     call test_refs
  30.     call test_valeurs
  31.     call test_connexions
  32.     call test_liaisons
  33.     end
  34.     otherwise do
  35.     'INIT(B,D,L,O,N)'
  36.     exit
  37.     end
  38. end
  39. call afficher_erreurs
  40. 'INIT(B,D,L,O,N)'
  41. exit
  42.  
  43. test_refs:
  44.     'LOCK(-1):TITLE("Vérification des références...")'
  45.     do i=1 to objets
  46.     'TYPE(O='i')'
  47.     if result=1 then do
  48.         'PARTNAME(O)'
  49.         if result~="ALIMENTATION" & result ~="MASSE" then do
  50.         'GETREF(O)'
  51.         if result=0 then do
  52.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de référence"+CHR(10)+"Voulez-vous continuer?")'
  53.             if result<1 then do
  54.             'UNLOCK(-1)'
  55.             return
  56.             end
  57.             'UNMARKCOMP(O)'
  58.             errrefs=errrefs+1
  59.         end
  60.         end
  61.     end
  62.     end
  63.     'UNLOCK(-1)'
  64. return
  65.  
  66. test_valeurs:
  67.     'LOCK(-1):TITLE("Vérification des valeurs..."):UNMARK(-1)'
  68.     do i=1 to objets
  69.     'TYPE(O='i')'
  70.     if result=1 then do
  71.         'PARTNAME(O)'
  72.         if result~="ALIMENTATION" & result ~="MASSE" then do
  73.         'GETVAL(O)'
  74.         if result=0 then do
  75.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de valeur"+CHR(10)+"Voulez-vous continuer?")'
  76.             if result<1 then do
  77.             'UNLOCK(-1)'
  78.             return
  79.             end
  80.             'UNMARKCOMP(O)'
  81.             errvals=errvals+1
  82.         end
  83.         end
  84.     end
  85.     end
  86.     'UNLOCK(-1)'
  87. return
  88.  
  89. test_doublets:
  90.     'LOCK(-1):TITLE("Vérification absence éléments doubles..."):UNMARK(-1)'
  91.     i=1
  92.     do while i>0
  93.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  94.     if i>0 then do
  95.         'N=FINDOBJ('i+1',1,COL(O),LINE(O))'; j=result
  96.         if j>0 then do
  97.         'IF(PARTNAME(O)==PARTNAME(N),IF(GETREF(N),DELETE(GETREF(N)),0):IF(GETVAL(N),DELETE(GETVAL(N)),0):DELETE(N):MARK(O),0):OBJECTS(-1)'; objets=result
  98.         doublets=doublets+1
  99.         end
  100.         if i>=objets-1 then i=0
  101.         else i=i+1
  102.     end
  103.     end
  104.     i=1
  105.     do while i>0
  106.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  107.     if i>0 then do
  108.         'GETREF(O)'; r=result
  109.         if r>0 then do
  110.         'D=FINDREF('i+1',READTEXT(GETREF(O)))'; d=result
  111.         if d>0 then do
  112.             'MARK(O,D):MESSAGE("Attention: la référence"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"est utilisée deux fois!")'
  113.         end
  114.         end
  115.         if i>=objets-1 then i=0
  116.         else i=i+1
  117.     end
  118.     end
  119.     'UNLOCK(-1)'
  120. return
  121.  
  122. test_connexions:
  123.     'LOCK(-1):TITLE("Vérification des liaisons aux composants..."):UNMARK(-1)'
  124.     i=1
  125.     do while i>0
  126.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  127.     if i>0 then do
  128.         'PARTNAME(O)'
  129.         'DEVPINS(O)'; j=result
  130.         do k=1 to j
  131.         if connexion_broche(i,k)=0 then do
  132.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"a sa borne "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" non connectée"+CHR(10)+"Voulez-vous continuer?")'
  133.             if result<1 then do
  134.             'UNLOCK(-1)'
  135.             return
  136.             end
  137.             'UNMARKCOMP(O)'
  138.             errconx=errconx+1
  139.         end
  140.         end
  141.         if i=objets then leave
  142.         i=i+1
  143.     end
  144.     end
  145.     'UNLOCK(-1)'
  146. return
  147.  
  148. test_liaisons:
  149.     'LOCK(-1):TITLE("Recherche et élimination lignes inutiles...")'
  150.     i=1
  151.     do while i>0
  152.     'O=FINDOBJ('i',2,-1,-1)'; i=result
  153.     if i>0 then do
  154.         'IF((COL(O)==ENDCOL(O))&(LINE(O)==ENDLINE(O)),DELETE(O),0)'
  155.         if result>0 then do
  156.         objets=result
  157.         eliminations=eliminations+1
  158.         end
  159.         else if i<objets then do
  160.         'IF(COL(O)==ENDCOL(O),1,IF(LINE(O)==ENDLINE(O),2,0))'
  161.         if result=1 then do    /* c'est une ligne verticale */
  162.             l=i+1
  163.             do while l>0
  164.             'L=FINDOBJ('l',2,COL(O),-1)'; l=result
  165.             if l>0 then do
  166.                 'IF(COL(L)==ENDCOL(L),COORDS(O)+","+COORDS(L),"")'
  167.                 if result~="" then do
  168.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  169.                 y4=min(y0,y1)
  170.                 y5=max(y0,y1)
  171.                 y6=min(y2,y3)
  172.                 y7=max(y2,y3)
  173.                 if y4<y7 & y5>y6 then call modifier_lignes(x0,min(y4,y6),x0,max(y5,y7))
  174.                 else if y4=y7 then do
  175.                     'FINDOBJ(1,7,'x0','y4')'
  176.                     if result=0 then call modifier_lignes(x0,y6,x0,y5)
  177.                 end
  178.                 else if y5=y6 then do
  179.                     'FINDOBJ(1,7,'x0','y5')'
  180.                     if result=0 then call modifier_lignes(x0,y4,x0,y7)
  181.                 end
  182.                 end
  183.             end
  184.             if l>0 then do
  185.                 if l>=objets then l=0
  186.                 else l=l+1
  187.             end
  188.             end
  189.         end
  190.         else if result=2 then do    /* c'est une ligne horizontale */
  191.             l=i+1
  192.             do while l>0
  193.             'L=FINDOBJ('l',2,-1,LINE(O))'; l=result
  194.             if l>0 then do
  195.                 'IF(LINE(L)==ENDLINE(L),COORDS(O)+","+COORDS(L),"")' /* est-ce bien une ligne horizontale? */
  196.                 if result~="" then do
  197.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  198.                 x4=min(x0,x1)
  199.                 x5=max(x0,x1)
  200.                 x6=min(x2,x3)
  201.                 x7=max(x2,x3)
  202.                 if x4<x7 & x5>x6 then call modifier_lignes(min(x4,x6),y0,max(x5,x7),y0)
  203.                 else if x4=x7 then do
  204.                     'FINDOBJ(1,7,'x4','y0')'
  205.                     if result=0 then call modifier_lignes(x6,y0,x5,y0)
  206.                 end
  207.                 else if x5=x6 then do
  208.                     'FINDOBJ(1,7,'x5','y0')'
  209.                     if result=0 then call modifier_lignes(x4,y0,x7,y0)
  210.                 end
  211.                 end
  212.             end
  213.             if l>0 then do
  214.                 if l>=objets then l=0
  215.                 else l=l+1
  216.             end
  217.             end
  218.         end
  219.         end
  220.         if i>=objets-1 then i=0
  221.         else i=i+1
  222.     end
  223.     else leave
  224.     end
  225.     'UNLOCK(-1)'
  226. return
  227.  
  228. afficher_erreurs:
  229.     if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Vérification terminée"+CHR(10)+"Aucune erreur trouvée")'
  230.     else do
  231.     t=""
  232.     if eliminations>0 then t=eliminations||" lignes nulles éliminées"
  233.     if modifs>0 then do
  234.         if t~="" then t=t||'0a'x||modifs||" lignes modifiées"
  235.         else t=modifs||" lignes modifiées"
  236.     end
  237.     if errrefs>0 then do
  238.         if t~="" then t=t||'0a'x||errrefs||" références manquantes"
  239.         else t=errrefs||" références manquantes"
  240.     end
  241.     if errvals>0 then do
  242.         if t~="" then t=t||'0a'x||errvals||" valeurs manquantes"
  243.         else t=errvals||" valeurs manquantes"
  244.     end
  245.     if errconx>0 then do
  246.         if t~="" then t=t||'0a'x||errconx||" connexions manquantes"
  247.         else t=errconx||" connexions manquantes"
  248.     end
  249.     if doublets>0 then do
  250.         if t~="" then t=t||'0a'x||doublets||" éléments supprimés"
  251.         else t=doublets||" éléments supprimés"
  252.     end
  253.     'MESSAGE("'t'")'
  254.     end
  255.     return
  256.  
  257. modifier_lignes:
  258.     parse arg xd,yd,xf,yf
  259.     'DRAWMODE(1):DELETE(L):DELETE(O):MARK(DRAW('xd','yd','xf','yf'))'
  260.     objets=objets-1
  261.     i=0; l=0
  262.     modifs=modifs+1
  263.     return
  264.  
  265. connexion_broche: procedure
  266.     parse arg objet,broche
  267.     'PINCOL(O='objet',B='broche')'; xj=result
  268.     'PINLINE(O,B)'; yj=result
  269.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  270.     if xl>0 then return xl
  271.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  272.     if xl<=0 then return 0
  273.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  274.     if result>0 then return xl
  275.     return 0
  276.  
  277. min: procedure
  278.     parse arg v1,v2
  279.     if v1<v2 then return v1
  280.     return v2
  281.  
  282. max: procedure
  283.     parse arg v1,v2
  284.     if v1>v2 then return v1
  285.     return v2
  286.  
  287. /* Traitement des erreurs, interruption du programme */
  288. syntax:
  289. erreur=RC
  290. 'UNLOCK(-1):MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):INIT(B,D,L,O,N)'
  291. exit
  292.  
  293. error:
  294. 'UNLOCK(-1):MESSAGE("Erreur en ligne 'SIGL'"):INIT(B,D,L,O,N)'
  295. exit
  296.